***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
SET PROC TO RDRUGDOC                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
@08,03 CLEA TO 22,78                                                                                                                                                                                                                                      
@10,25 SAY 'REPORT OF THE USAGE OF MEDICINE PER DOCTOR'                                                                                                                                                                                                   
@12,25 SAY 'DATE :   /  /     TO   /  /  '                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
STOR CTOD('  /  /    ') TO dDate1, dDate2                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
DO WHIL .T.                                                                                                                                                                                                                                               
   @12,32 GET dDate1                                                                                                                                                                                                                                      
   READ                                                                                                                                                                                                                                                   
   IF dDate1 = CTOD('  /  /    ')                                                                                                                                                                                                                         
      EXIT                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
   @12,44 GET dDate2                                                                                                                                                                                                                                      
   READ                                                                                                                                                                                                                                                   
   IF dDate2 = CTOD('  /  /    ')                                                                                                                                                                                                                         
      EXIT                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
                                                                                                                                                                                                                                                          
   svconf = SAVESCREEN(00,00,24,79)                                                                                                                                                                                                                       
    SET COLO TO W+/N,W+/R                                                                                                                                                                                                                                 
   @14,24 CLEA TO 16,45                                                                                                                                                                                                                                   
   @14,24 TO 16,45 DOUBLE                                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
   @15,25 PROMPT 'PRINT'                                                                                                                                                                                                                                  
   @15,30 SAY '/'                                                                                                                                                                                                                                         
   @15,31 PROMPT 'CANCEL'                                                                                                                                                                                                                                 
   @15,38 SAY '/'                                                                                                                                                                                                                                         
   @15,39 PROMPT 'ESCAPE'                                                                                                                                                                                                                                 
   MENU TO nJw                                                                                                                                                                                                                                            
                                                                                                                                                                                                                                                          
   SET COLO TO W/B,W+/BG                                                                                                                                                                                                                                  
   RESTSCREEN(00,00,24,79,svconf)                                                                                                                                                                                                                         
   DO CASE                                                                                                                                                                                                                                                
      CASE nJw = 1                                                                                                                                                                                                                                        
         DO PDRUGDOC                                                                                                                                                                                                                                      
         EXIT                                                                                                                                                                                                                                             
      CASE nJw = 2                                                                                                                                                                                                                                        
         LOOP                                                                                                                                                                                                                                             
      CASE nJw = 3                                                                                                                                                                                                                                        
         EXIT                                                                                                                                                                                                                                             
   ENDC                                                                                                                                                                                                                                                   
ENDD                                                                                                                                                                                                                                                      
SET COLO TO W/N,W/N                                                                                                                                                                                                                                       
CLEA                                                                                                                                                                                                                                                      
CLOS ALL                                                                                                                                                                                                                                                  
RETU                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
PROC PDRUGDOC                                                                                                                                                                                                                                             
*------------                                                                                                                                                                                                                                             
*         1         2         3         4         5         6         7         8                                                                                                                                                                         
*12345678901234567890123456789012345678901234567890123456789012345678901234567890                                                                                                                                                                         
*     USAGE OF MEDICINE PER DOCTOR  DATE : 99/99/9999                                                                                                                                                                                                     
*          99/99/9999 - 99/99/99      PAGE : 9,999                                                                                                                                                                                                        
*==================================================                                                                                                                                                                                                       
*CODE       NAME                      QUANTITY                                                                                                                                                                                                            
*==================================================                                                                                                                                                                                                       
*DOCTOR : XXX-XXXXXXXXXXXX                                                                                                                                                                                                                                
*XXXXX      X------------------X        99,999                                                                                                                                                                                                            
                                                                                                                                                                                                                                                          
@13,25 SAY 'Processing...'                                                                                                                                                                                                                                
DR1 = 'N:'                                                                                                                                                                                                                                                
DR2 = 'N:'                                                                                                                                                                                                                                                
F1  = 'ACT_PHAY'                                                                                                                                                                                                                                          
F2  = 'DRUGS'                                                                                                                                                                                                                                             
F21 = 'DRUGSCOD'                                                                                                                                                                                                                                          
F3  = 'TEMP_DRU'                                                                                                                                                                                                                                          
F4  = 'DOCT_YTD'                                                                                                                                                                                                                                          
F41 = 'DOCTINVX'                                                                                                                                                                                                                                          
F5  = 'DOC_PHAR'                                                                                                                                                                                                                                          
F6  = 'DISPOS'                                                                                                                                                                                                                                            
                                                                                                                                                                                                                                                          
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F1                                                                                                                                                                                                                                               
COPY STRU TO &DR1&F3                                                                                                                                                                                                                                      
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F3                                                                                                                                                                                                                                               
APPE FROM &DR1&F1 FOR DATE_VISIT >= dDate1 .AND. DATE_VISIT <= dDate2                                                                                                                                                                                     
*INDE ON PHAR_CODE TO &DR1&F3                                                                                                                                                                                                                             
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SET EXCLU ON                                                                                                                                                                                                                                              
USE &DR1&F5                                                                                                                                                                                                                                               
ZAP                                                                                                                                                                                                                                                       
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F3                                                                                                                                                                                                                                               
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F4 INDE &DR1&F41                                                                                                                                                                                                                                 
SELE 3                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F5                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
DO WHIL .NOT. EOF()                                                                                                                                                                                                                                       
   cInvcod  = INV_NBER                                                                                                                                                                                                                                    
   cPharcod = PHAR_CODE                                                                                                                                                                                                                                   
   cPharx   = PHAR_X                                                                                                                                                                                                                                      
   cDoccod  = SPAC(3)                                                                                                                                                                                                                                     
   cDocal   = SPAC(12)                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
   SELE 2                                                                                                                                                                                                                                                 
   SEEK cInvcod                                                                                                                                                                                                                                           
   IF .NOT. EOF()                                                                                                                                                                                                                                         
      cDoccod = DOC_CODE                                                                                                                                                                                                                                  
      cDocal  = DOC_ALIAS                                                                                                                                                                                                                                 
   ENDI                                                                                                                                                                                                                                                   
                                                                                                                                                                                                                                                          
   SELE 3                                                                                                                                                                                                                                                 
   APPE BLAN                                                                                                                                                                                                                                              
   REPL DOC_CODE WITH cDoccod, DOC_ALIAS WITH cDocal, PHAR_COD WITH cPharcod,;                                                                                                                                                                            
        PHAR_X WITH cPharx                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
   SELE 1                                                                                                                                                                                                                                                 
   SKIP                                                                                                                                                                                                                                                   
ENDD                                                                                                                                                                                                                                                      
SELE 3                                                                                                                                                                                                                                                    
INDE ON DOC_CODE+PHAR_COD TO &DR1&F5                                                                                                                                                                                                                      
CLOS ALL                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
@13,25 SAY 'Printing...  '                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F5 INDE &DR1&F5                                                                                                                                                                                                                                  
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR2&F2 INDE &DR2&F2                                                                                                                                                                                                                                  
SELE 3                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR1&F6 INDE &DR1&F6                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
SET PRIN ON                                                                                                                                                                                                                                               
SET DEVI TO PRIN                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
STOR 0 TO nHal, nBrs, nQty                                                                                                                                                                                                                                
DO HDRDRUDC                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
DO WHIL .NOT. EOF()                                                                                                                                                                                                                                       
   cDoccod = DOC_CODE                                                                                                                                                                                                                                     
   @nBrs,01 SAY 'DOCTOR : '                                                                                                                                                                                                                               
   @nBrs,10 SAY DOC_CODE+'-'+DOC_ALIAS                                                                                                                                                                                                                    
   nBrs = nBrs + 1                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
   DO WHIL cDoccod = DOC_CODE .AND. .NOT. EOF()                                                                                                                                                                                                           
      cCode = PHAR_COD                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
      SELE 2                                                                                                                                                                                                                                              
      SEEK cCode                                                                                                                                                                                                                                          
      IF .NOT. EOF()                                                                                                                                                                                                                                      
         cName = DRUG_NAME                                                                                                                                                                                                                                
      ELSE                                                                                                                                                                                                                                                
         SELE 3                                                                                                                                                                                                                                           
         SEEK cCode                                                                                                                                                                                                                                       
         IF .NOT. EOF()                                                                                                                                                                                                                                   
            cName = DISP_NAME                                                                                                                                                                                                                             
         ELSE                                                                                                                                                                                                                                             
            cName = SPAC(20)                                                                                                                                                                                                                              
         ENDI                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
      SELE 1                                                                                                                                                                                                                                              
      STOR 0 TO nQty                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
      DO WHIL cCode = PHAR_COD .AND. cDoccod = DOC_CODE .AND. .NOT. EOF()                                                                                                                                                                                 
         nQty  = nQty + PHAR_X                                                                                                                                                                                                                            
         SKIP                                                                                                                                                                                                                                             
      ENDD                                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
      IF nBrs > 56                                                                                                                                                                                                                                        
         DO HDRDRUDC                                                                                                                                                                                                                                      
      ENDI                                                                                                                                                                                                                                                
      @nBrs,01 SAY cCode                                                                                                                                                                                                                                  
      @nBrs,12 SAY cName                                                                                                                                                                                                                                  
      @nBrs,40 SAY nQty PICT '99,999'                                                                                                                                                                                                                     
      nBrs = nBrs + 1                                                                                                                                                                                                                                     
   ENDD                                                                                                                                                                                                                                                   
   nBrs = nBrs + 1                                                                                                                                                                                                                                        
ENDD                                                                                                                                                                                                                                                      
nBrs = nBrs - 1                                                                                                                                                                                                                                           
@nBrs,01 SAY '=================================================='                                                                                                                                                                                         
SET PRIN OFF                                                                                                                                                                                                                                              
SET DEVI TO SCREE                                                                                                                                                                                                                                         
RETU                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
PROC HDRDRUDC                                                                                                                                                                                                                                             
*------------                                                                                                                                                                                                                                             
nHal = nHal + 1                                                                                                                                                                                                                                           
@01,06 SAY 'USAGE OF MEDICINE PER DOCTOR'                                                                                                                                                                                                                 
@01,36 SAY 'DATE :'                                                                                                                                                                                                                                       
@01,43 SAY DATE()                                                                                                                                                                                                                                         
@02,11 SAY dDate1                                                                                                                                                                                                                                         
@02,20 SAY '-'                                                                                                                                                                                                                                            
@02,22 SAY dDate2                                                                                                                                                                                                                                         
@02,36 SAY 'PAGE :'                                                                                                                                                                                                                                       
@02,43 SAY nHal PICT '9,999'                                                                                                                                                                                                                              
@03,01 SAY '=================================================='                                                                                                                                                                                           
@04,01 SAY 'CODE       NAME                      QUANTITY'                                                                                                                                                                                                
@05,01 SAY '=================================================='                                                                                                                                                                                           
nBrs = 7                                                                                                                                                                                                                                                  
RETU                                                                                                                                                                                                                                                      
